Gestures for Globes Research

Data and Libraries Load

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(dplyr)
library(car)
## Loading required package: carData
## 
## Attaching package: 'car'
## 
## The following object is masked from 'package:dplyr':
## 
##     recode
## 
## The following object is masked from 'package:purrr':
## 
##     some
library(ggplot2)
library(lubridate)
library(scales)
## 
## Attaching package: 'scales'
## 
## The following object is masked from 'package:purrr':
## 
##     discard
## 
## The following object is masked from 'package:readr':
## 
##     col_factor
library(ARTool)
library(knitr)

data <- read_csv("study_tasks.csv")
## Rows: 49244 Columns: 35
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr   (9): TaskID, ActionID, distance, direction, complexity, zoomDirection,...
## dbl  (22): UserID, main_translation_x, main_translation_y, main_translation_...
## lgl   (3): rotateGlobeWhileDragging, oneHandedRotationGesture, moveGlobeWhil...
## dttm  (1): Date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
demographic <- read_csv("final_introductory.csv")
## Rows: 12 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): Timestamp, Academic_level, Gender, Age_group, Exp_ARVR, Globe_usage...
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
positioning_NRG <- read_csv("final_positioning_NRG.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
positioning_RG <- read_csv("final_positioning_RG.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
positioning_preference <- read_csv("final_positioning_comparison.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Positioning_preference, Positioning_feedback
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
rotation_OH <- read_csv("final_rotation_OH.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
rotation_TH <- read_csv("final_rotation_TH.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
rotation_preference <- read_csv("final_rotation_comparison.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Rotation_preference, Rotation_feedback
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
scale_MG <- read_csv("final_scale_MG.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
scale_NMG <- read_csv("final_scale_NMG.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Mentally_demanding, Physically_demanding
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
scale_preference <- read_csv("final_scale_comparison.csv")
## Rows: 12 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Timestamp, Scale_preference, Scale_feedback
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
combined_preference <- read_csv("final_outro_comparison.csv")
## Rows: 12 Columns: 6
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (5): Timestamp, Combined_positioning_preference, Combined_rotation_prefe...
## dbl (1): UserID
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
summary(data)
##      UserID          TaskID            ActionID        
##  Min.   : 1.000   Length:49244       Length:49244      
##  1st Qu.: 4.000   Class :character   Class :character  
##  Median : 7.000   Mode  :character   Mode  :character  
##  Mean   : 6.741                                        
##  3rd Qu.:10.000                                        
##  Max.   :12.000                                        
##  rotateGlobeWhileDragging oneHandedRotationGesture moveGlobeWhileScaling
##  Mode :logical            Mode :logical            Mode :logical        
##  FALSE:36803              FALSE:11933              FALSE:46552          
##  TRUE :12441              TRUE :37311              TRUE :2692           
##                                                                         
##                                                                         
##                                                                         
##    distance          direction          complexity        zoomDirection     
##  Length:49244       Length:49244       Length:49244       Length:49244      
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##       Date                            Type           ActionStatus      
##  Min.   :2025-04-23 05:27:13.00   Length:49244       Length:49244      
##  1st Qu.:2025-04-25 01:36:58.00   Class :character   Class :character  
##  Median :2025-04-26 00:45:01.00   Mode  :character   Mode  :character  
##  Mean   :2025-04-27 21:46:53.98                                        
##  3rd Qu.:2025-05-01 07:26:51.00                                        
##  Max.   :2025-05-05 23:37:33.00                                        
##  main_translation_x  main_translation_y main_translation_z main_rotation_x   
##  Min.   :-7.099065   Min.   :-0.3298    Min.   :-3.487     Min.   :-0.97540  
##  1st Qu.:-0.400000   1st Qu.: 0.9000    1st Qu.:-1.921     1st Qu.:-0.03161  
##  Median :-0.004060   Median : 0.9000    Median :-1.500     Median : 0.00000  
##  Mean   :-0.005048   Mean   : 1.2326    Mean   :-1.683     Mean   :-0.03896  
##  3rd Qu.: 0.400000   3rd Qu.: 1.5539    3rd Qu.:-1.500     3rd Qu.: 0.00000  
##  Max.   : 3.256168   Max.   : 3.8304    Max.   : 5.006     Max.   : 0.97834  
##  main_rotation_y   main_rotation_z    main_rotation_w       main_scale_x    
##  Min.   :-1.0000   Min.   :-0.97710   Min.   :-0.9997261   Min.   :0.08431  
##  1st Qu.:-0.2033   1st Qu.: 0.00000   1st Qu.: 0.0000001   1st Qu.:0.99989  
##  Median : 0.9601   Median : 0.00000   Median : 0.0626987   Median :1.00000  
##  Mean   : 0.5003   Mean   : 0.01287   Mean   : 0.2756917   Mean   :0.99575  
##  3rd Qu.: 1.0000   3rd Qu.: 0.00000   3rd Qu.: 0.6346812   3rd Qu.:1.00002  
##  Max.   : 1.0000   Max.   : 0.98922   Max.   : 0.9999814   Max.   :7.69231  
##   main_scale_y      main_scale_z     target_translation_x target_translation_y
##  Min.   :0.08431   Min.   :0.08431   Min.   :-3.10000     Min.   :0.613       
##  1st Qu.:0.99994   1st Qu.:0.99990   1st Qu.:-0.40000     1st Qu.:0.900       
##  Median :1.00000   Median :1.00000   Median : 0.00000     Median :0.900       
##  Mean   :0.99577   Mean   :0.99576   Mean   :-0.02449     Mean   :1.245       
##  3rd Qu.:1.00002   3rd Qu.:1.00002   3rd Qu.: 0.40000     3rd Qu.:1.773       
##  Max.   :7.69231   Max.   :7.69231   Max.   : 2.33777     Max.   :2.547       
##  target_translation_z target_rotation_x target_rotation_y target_rotation_z 
##  Min.   :-3.3210      Min.   :-0.3928   Min.   :-0.6935   Min.   :-0.21194  
##  1st Qu.:-1.9598      1st Qu.:-0.3584   1st Qu.:-0.5655   1st Qu.: 0.00000  
##  Median :-1.5000      Median : 0.0000   Median : 1.0000   Median : 0.00000  
##  Mean   :-1.6971      Mean   :-0.1153   Mean   : 0.3768   Mean   :-0.01644  
##  3rd Qu.:-1.5000      3rd Qu.: 0.0000   3rd Qu.: 1.0000   3rd Qu.: 0.00000  
##  Max.   :-0.8953      Max.   : 0.0000   Max.   : 1.0000   Max.   : 0.13795  
##  target_rotation_w    target_scale_x   target_scale_y   target_scale_z  
##  Min.   :-0.9761015   Min.   :0.1700   Min.   :0.1700   Min.   :0.1700  
##  1st Qu.: 0.0000001   1st Qu.:1.0000   1st Qu.:1.0000   1st Qu.:1.0000  
##  Median : 0.0000001   Median :1.0000   Median :1.0000   Median :1.0000  
##  Mean   : 0.2914215   Mean   :0.9946   Mean   :0.9946   Mean   :0.9946  
##  3rd Qu.: 0.7119398   3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.0000  
##  Max.   : 0.9807853   Max.   :2.0000   Max.   :2.0000   Max.   :2.0000  
##  match_accuracy_result    status         
##  Min.   : 0.00000      Length:49244      
##  1st Qu.: 0.00000      Class :character  
##  Median : 0.00000      Mode  :character  
##  Mean   : 0.03784                        
##  3rd Qu.: 0.00000                        
##  Max.   :22.31002
summary(demographic)
##      UserID       Timestamp         Academic_level        Gender         
##  Min.   : 1.00   Length:12          Length:12          Length:12         
##  1st Qu.: 3.75   Class :character   Class :character   Class :character  
##  Median : 6.50   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 6.50                                                           
##  3rd Qu.: 9.25                                                           
##  Max.   :12.00                                                           
##   Age_group           Exp_ARVR         Globe_usage_frequency
##  Length:12          Length:12          Length:12            
##  Class :character   Class :character   Class :character     
##  Mode  :character   Mode  :character   Mode  :character     
##                                                             
##                                                             
##                                                             
##  Have_used_VisionPro
##  Length:12          
##  Class :character   
##  Mode  :character   
##                     
##                     
## 
summary(positioning_NRG)
##      UserID       Timestamp         Mentally_demanding Physically_demanding
##  Min.   : 1.00   Length:12          Length:12          Length:12           
##  1st Qu.: 3.75   Class :character   Class :character   Class :character    
##  Median : 6.50   Mode  :character   Mode  :character   Mode  :character    
##  Mean   : 6.50                                                             
##  3rd Qu.: 9.25                                                             
##  Max.   :12.00
summary(positioning_RG)
##      UserID       Timestamp         Mentally_demanding Physically_demanding
##  Min.   : 1.00   Length:12          Length:12          Length:12           
##  1st Qu.: 3.75   Class :character   Class :character   Class :character    
##  Median : 6.50   Mode  :character   Mode  :character   Mode  :character    
##  Mean   : 6.50                                                             
##  3rd Qu.: 9.25                                                             
##  Max.   :12.00
summary(positioning_preference)
##      UserID       Timestamp         Positioning_preference Positioning_feedback
##  Min.   : 1.00   Length:12          Length:12              Length:12           
##  1st Qu.: 3.75   Class :character   Class :character       Class :character    
##  Median : 6.50   Mode  :character   Mode  :character       Mode  :character    
##  Mean   : 6.50                                                                 
##  3rd Qu.: 9.25                                                                 
##  Max.   :12.00
summary(rotation_OH)
##      UserID       Timestamp         Mentally_demanding Physically_demanding
##  Min.   : 1.00   Length:12          Length:12          Length:12           
##  1st Qu.: 3.75   Class :character   Class :character   Class :character    
##  Median : 6.50   Mode  :character   Mode  :character   Mode  :character    
##  Mean   : 6.50                                                             
##  3rd Qu.: 9.25                                                             
##  Max.   :12.00
summary(rotation_TH)
##      UserID       Timestamp         Mentally_demanding Physically_demanding
##  Min.   : 1.00   Length:12          Length:12          Length:12           
##  1st Qu.: 3.75   Class :character   Class :character   Class :character    
##  Median : 6.50   Mode  :character   Mode  :character   Mode  :character    
##  Mean   : 6.50                                                             
##  3rd Qu.: 9.25                                                             
##  Max.   :12.00
summary(rotation_preference)
##      UserID       Timestamp         Rotation_preference Rotation_feedback 
##  Min.   : 1.00   Length:12          Length:12           Length:12         
##  1st Qu.: 3.75   Class :character   Class :character    Class :character  
##  Median : 6.50   Mode  :character   Mode  :character    Mode  :character  
##  Mean   : 6.50                                                            
##  3rd Qu.: 9.25                                                            
##  Max.   :12.00
summary(scale_MG)
##      UserID       Timestamp         Mentally_demanding Physically_demanding
##  Min.   : 1.00   Length:12          Length:12          Length:12           
##  1st Qu.: 3.75   Class :character   Class :character   Class :character    
##  Median : 6.50   Mode  :character   Mode  :character   Mode  :character    
##  Mean   : 6.50                                                             
##  3rd Qu.: 9.25                                                             
##  Max.   :12.00
summary(scale_NMG)
##      UserID       Timestamp         Mentally_demanding Physically_demanding
##  Min.   : 1.00   Length:12          Length:12          Length:12           
##  1st Qu.: 3.75   Class :character   Class :character   Class :character    
##  Median : 6.50   Mode  :character   Mode  :character   Mode  :character    
##  Mean   : 6.50                                                             
##  3rd Qu.: 9.25                                                             
##  Max.   :12.00
summary(scale_preference)
##      UserID       Timestamp         Scale_preference   Scale_feedback    
##  Min.   : 1.00   Length:12          Length:12          Length:12         
##  1st Qu.: 3.75   Class :character   Class :character   Class :character  
##  Median : 6.50   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 6.50                                                           
##  3rd Qu.: 9.25                                                           
##  Max.   :12.00
summary(combined_preference)
##      UserID       Timestamp         Combined_positioning_preference
##  Min.   : 1.00   Length:12          Length:12                      
##  1st Qu.: 3.75   Class :character   Class :character               
##  Median : 6.50   Mode  :character   Mode  :character               
##  Mean   : 6.50                                                     
##  3rd Qu.: 9.25                                                     
##  Max.   :12.00                                                     
##  Combined_rotation_preference Combined_scale_preference Combined_feedback 
##  Length:12                    Length:12                 Length:12         
##  Class :character             Class :character          Class :character  
##  Mode  :character             Mode  :character          Mode  :character  
##                                                                           
##                                                                           
## 

Participants Demographic Information

# Total number of participants
length(unique(data$UserID))
## [1] 12
# Participants' gender distribution
demographic.gender <-  demographic %>%
  select(UserID, Gender) %>%
  distinct() %>%
  group_by(Gender) %>%
  summarise(count = n()) %>%
  mutate(percentage = round(count / sum(count) * 100, 1), percentage = paste0(percentage, "%"))

demographic.gender
## # A tibble: 2 × 3
##   Gender count percentage
##   <chr>  <int> <chr>     
## 1 Man       10 83.3%     
## 2 Woman      2 16.7%
# Participants' gender distribution chart
ggplot(demographic.gender, aes(x = "", y = count, fill = Gender)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  geom_text(aes(label = percentage), position = position_stack(vjust = 0.5), size = 4) +
  labs(title = "Distribution of Participants' Gender") +
  theme_void()

# Participants' academic level distribution
demographic.academic_level <-  demographic %>%
  select(UserID, Academic_level) %>%
  distinct() %>%
  group_by(Academic_level) %>%
  summarise(count = n()) %>%
  mutate(percentage = round(count / sum(count) * 100, 1), graph_label = paste0(percentage, "%")) %>%
  rename(`Academic levels` = Academic_level)

demographic.academic_level
## # A tibble: 3 × 4
##   `Academic levels`       count percentage graph_label
##   <chr>                   <int>      <dbl> <chr>      
## 1 Graduate Student           10       83.3 83.3%      
## 2 Postdoctoral Researcher     1        8.3 8.3%       
## 3 Undergraduate Student       1        8.3 8.3%
# Participants' academic level distribution chart
ggplot(demographic.academic_level, aes(x = "", y = count, fill = `Academic levels`)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  geom_text(aes(label = graph_label), position = position_stack(vjust = 0.5), size = 4) +
  labs(title = "Distribution of Participants' Academic Level") +
  theme_void() 

# Participants' previous AR/VR experience distribution
demographic.ARVR_exp <-  demographic %>%
  select(UserID, Exp_ARVR ) %>%
  distinct() %>%
  group_by(Exp_ARVR) %>%
  summarise(count = n()) %>%
  mutate(percentage = round(count / sum(count) * 100, 1), 
         label = paste0(percentage, "%"),
         ShortLabel = fct_recode(Exp_ARVR,
                          "No experience" = "I have no experience")
) %>%
  rename(`Previous AR/VR experience` = ShortLabel)

demographic.ARVR_exp
## # A tibble: 3 × 5
##   Exp_ARVR                         count percentage label Previous AR/VR exper…¹
##   <chr>                            <int>      <dbl> <chr> <fct>                 
## 1 Beginner (less than 5 hours exp…     4       33.3 33.3% Beginner (less than 5…
## 2 Familiar (5-20 hours experience)     3       25   25%   Familiar (5-20 hours …
## 3 I have no experience                 5       41.7 41.7% No experience         
## # ℹ abbreviated name: ¹​`Previous AR/VR experience`
# Participants' previous AR/VR experience distribution chart
ggplot(demographic.ARVR_exp, aes(x = "", y = count, fill = `Previous AR/VR experience`)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  geom_text(aes(label = label), position = position_stack(vjust = 0.5), size = 4) +
  labs(title = "Distribution of Participants Previous AR/VR Experience") +
  theme_void() 

# Participants' previous globe experience distribution
demographic.globes_exp <- demographic %>%
  select(UserID, Globe_usage_frequency) %>%
  distinct() %>%
  group_by(Globe_usage_frequency) %>%
  summarise(count = n()) %>%
  mutate(percentage = round(count / sum(count) * 100, 1),
         graph_label = paste0(percentage, "%")) %>%
  rename(`Previous globes experience` = Globe_usage_frequency)

demographic.globes_exp
## # A tibble: 3 × 4
##   `Previous globes experience` count percentage graph_label
##   <chr>                        <int>      <dbl> <chr>      
## 1 A few times a month              1        8.3 8.3%       
## 2 A few times a year               3       25   25%        
## 3 Once every few years             8       66.7 66.7%
# Participants' previous globe experience distribution chart
ggplot(demographic.globes_exp, aes(x = "", y = count, fill = `Previous globes experience`)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  geom_text(aes(label = graph_label), position = position_stack(vjust = 0.5), size = 4) +
  labs(title = "Distribution of Participants Previous AR/VR Experience") +
  theme_void() 

# Participants' previous Apple Vision Pro Experience distribution
demographic.visionpro_exp <- demographic %>%
  select(UserID, Have_used_VisionPro) %>%
  distinct() %>%
  group_by(Have_used_VisionPro) %>%
  summarise(count = n()) %>%
  mutate(
    percentage = round(count / sum(count) * 100, 1),
    graph_label = paste0(percentage, "%")
  ) %>%
  rename(`Have used Apple Vision Pro` = Have_used_VisionPro)
  
demographic.visionpro_exp
## # A tibble: 2 × 4
##   `Have used Apple Vision Pro`                   count percentage graph_label
##   <chr>                                          <int>      <dbl> <chr>      
## 1 I have never used the Apple Vision Pro            11       91.7 91.7%      
## 2 I have used the Apple Vision Pro once or twice     1        8.3 8.3%
# Participants' previous Apple Vision Pro Experience distribution chart
ggplot(demographic.visionpro_exp, aes(x = "", y = count, fill = `Have used Apple Vision Pro`)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  geom_text(aes(label = graph_label), position = position_stack(vjust = 0.5), size = 4) +
  labs(title = "Distribution of Participants Previous AR/VR Experience") +
  theme_void()   

Notes: Use boxplot instead of bar chart Add technique column

Structure it like this:

Study: Positioning

Positioning Data Preparation

data.positioning <- data %>%
  inner_join(demographic, by = "UserID") %>%
  inner_join(positioning_NRG, by = "UserID") %>%
  rename(
    PAAS_NRG = Mentally_demanding,
    BORG_NRG = Physically_demanding
  ) %>%
  mutate(
    PAAS_NRG = as.numeric(str_extract(PAAS_NRG, "\\d+(\\.\\d+)?")),
    BORG_NRG = as.numeric(str_extract(BORG_NRG, "\\d+(\\.\\d+)?"))
  ) %>%
  inner_join(positioning_RG, by = "UserID") %>%
  rename(
    PAAS_RG = Mentally_demanding,
    BORG_RG = Physically_demanding
  ) %>%
  mutate(
    PAAS_RG = as.numeric(str_extract(PAAS_RG, "\\d+(\\.\\d+)?")),
    BORG_RG = as.numeric(str_extract(BORG_RG, "\\d+(\\.\\d+)?"))
  ) %>%
  inner_join(positioning_preference, by = "UserID") %>%
  rename(
    behaviour_preference = Positioning_preference,
    behaviour_feedback = Positioning_feedback
  ) %>%
  mutate(
      behaviour_preference = case_when(
    str_detect(behaviour_preference, "Static orientation") ~ "staticOrientation",
    str_detect(behaviour_preference, "Adaptive orientation") ~ "adaptiveOrientation",
    str_detect(behaviour_preference, "no preference") ~ "noPreference",
    TRUE ~ "unknown"
  ) ) %>%
  filter(Type == "positionTask") %>%
  select(UserID, TaskID, ActionID, rotateGlobeWhileDragging, distance, direction, Date, ActionStatus, main_translation_x,
  main_translation_y, main_translation_z, target_translation_x, target_translation_y, target_translation_z, 
  match_accuracy_result, status, PAAS_NRG, BORG_NRG, PAAS_RG, BORG_RG, behaviour_preference, behaviour_feedback) %>%
  mutate(positionCondition = if_else(rotateGlobeWhileDragging, "rotatingGlobe", "nonRotatingGlobe")) %>%
  select(-rotateGlobeWhileDragging) %>%
  mutate(distance = as.factor(distance), 
         direction = as.factor(direction), 
         positionCondition = as.factor(positionCondition),
         status = as.factor(status),
         behaviour_preference = as.factor(behaviour_preference))

Position Task Study

### Accuracy
#### Normality
data.positioning.matched <- data.positioning %>%
  filter(status == "Matched")

shapiro.test(data.positioning.matched$match_accuracy_result)
## 
##  Shapiro-Wilk normality test
## 
## data:  data.positioning.matched$match_accuracy_result
## W = 0.97029, p-value = 2.086e-09
hist(data.positioning.matched$match_accuracy_result, breaks = 100,
     main = "Histogram (Zoomed)", xlab = "Accuracy",
     col = "lightblue", xlim = c(0, 0.06))

plot(density(data.positioning.matched$match_accuracy_result), 
     main = "Density Plot (Zoomed)", xlab = "Accuracy",
     col = "blue", lwd = 2, xlim = c(0, 0.6))

# Although the w value is close to 1, the p value is below 0.05 so we reject null hypothesis that the data is normally distributed
# So, we cannot use one way ANOVA, instead, we use Wilcoxon signed-rank test

#### Statistical tests 
data.positioning.matched.accuracy_avg.long <- data.positioning.matched %>%
  group_by(UserID, positionCondition) %>%
  summarise(mean_accuracy = mean(match_accuracy_result, na.rm = TRUE), .groups = 'drop')

data.positioning.matched.art <- art(mean_accuracy ~ positionCondition + (1|UserID), data = data.positioning.matched.accuracy_avg.long)

anova(data.positioning.matched.art)
## Analysis of Variance of Aligned Rank Transformed Data
## 
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df) 
## Model: Mixed Effects (lmer)
## Response: art(mean_accuracy)
## 
##                           F Df Df.res Pr(>F)  
## 1 positionCondition 0.33588  1     11 0.5739  
## ---
## Signif. codes:   0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Factor tested: positionCondition (e.g., rotatingGlobe vs nonRotatingGlobe)
# F-statistic: 0.33588 — this tells us the ratio of variance between the groups to the variance within groups (after aligned rank transformation).
# Degrees of freedom (df): 1 for the factor, and 11 for the residuals (which likely means 12 participants).
# p-value: 0.5739 — this is not statistically significant at any common threshold (e.g., 0.05).

# An ART ANOVA revealed no significant effect of position condition (rotating vs non-rotating) on match accuracy, F(1, 11) = 0.34, p = .574.

ggplot(data.positioning.matched.accuracy_avg.long, aes(x = positionCondition, y = mean_accuracy, group = UserID)) +
  geom_line(aes(color = as.factor(UserID))) +
  geom_point(size = 3) +
  labs(title = "Paired Accuracy: Moving vs Non-Moving Globe",
       x = "Condition",
       y = "Match Accuracy") +
  theme_minimal()

ggplot(data.positioning.matched.accuracy_avg.long, aes(x = positionCondition, y = mean_accuracy)) +
  geom_boxplot(outlier.shape = NA, fill = "lightblue") +
  geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
  labs(title = "Accuracy by Globe Movement Condition",
       x = "Condition",
       y = "Match Accuracy") +
  theme_minimal()

### Completion Time
data.positioning.taskCompletion_avg <- data.positioning %>%
  group_by(UserID, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  )

shapiro.test(data.positioning.taskCompletion_avg$completion_time)
## 
##  Shapiro-Wilk normality test
## 
## data:  data.positioning.taskCompletion_avg$completion_time
## W = 0.59479, p-value < 2.2e-16
data.positioning.taskCompletion_avg.long <- data.positioning %>%
  group_by(UserID, positionCondition, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  ) %>%
  group_by(UserID, positionCondition) %>%
  summarise(
    avg_completion_time = mean(completion_time),
    .groups = "drop"
  ) 
  # %>%
  # pivot_wider(names_from = positionCondition, values_from = avg_completion_time)

# wilcox.test(
#   data.positioning.taskCompletion_avg.wide$rotatingGlobe,
#   data.positioning.taskCompletion_avg.wide$nonRotatingGlobe,
#   paired = TRUE,
#   alternative = "two.sided"
# )

data.positioning.taskCompletion_avg.art <- art(avg_completion_time ~ positionCondition + (1|UserID), data = data.positioning.taskCompletion_avg.long)

anova(data.positioning.taskCompletion_avg.art)
## Analysis of Variance of Aligned Rank Transformed Data
## 
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df) 
## Model: Mixed Effects (lmer)
## Response: art(avg_completion_time)
## 
##                           F Df Df.res  Pr(>F)  
## 1 positionCondition 0.26366  1     11 0.61777  
## ---
## Signif. codes:   0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# The test statistic is F(1, 11) = 0.264, with a p-value of 0.618.
# Since p > 0.05, the result is not statistically significant.
# This means that there is no evidence of a significant effect of positionCondition on avg_completion_time.
# 
# An aligned rank transform ANOVA showed that position condition did not significantly affect average task completion time, F(1, 11) = 0.26, p = .618.

# data.positioning.taskCompletion_avg.long <- data.positioning.taskCompletion_avg.wide %>%
#   pivot_longer(cols = c(rotatingGlobe, nonRotatingGlobe),
#                names_to = "Condition",
#                values_to = "completion_time")

ggplot(data.positioning.taskCompletion_avg.long, aes(x = positionCondition, y = avg_completion_time, group = UserID)) +
  geom_line(aes(color = as.factor(UserID)), linewidth = 1, alpha = 0.6) +
  geom_point(size = 3) +
  labs(
    title = "Task Completion Time by Condition",
    x = "Condition",
    y = "Completion Time (minutes)",
    color = "UserID"
  ) +
  theme_minimal()

ggplot(data.positioning.taskCompletion_avg.long, aes(x = positionCondition, y = avg_completion_time)) +
  geom_boxplot(outlier.shape = NA, fill = "lightblue") +
  geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
  labs(title = "Accuracy by Globe Movement Condition",
       x = "Condition",
       y = "Match Accuracy") +
  theme_minimal()

### Subjective Measures
#### Physical and Mental Exertion

# Spearman’s rank correlation is a non-parametric test.
# It does not assume normal distribution of the variables.
# It works on ranks of the data, not the raw values — so it’s robust against skewed or non-normal distributions.

data.positioning.matched.RG <- data.positioning.matched %>% 
  filter(positionCondition == "rotatingGlobe")

cor.test(data.positioning.matched.RG$BORG_RG, 
         data.positioning.matched.RG$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.positioning.matched.RG$BORG_RG,
## data.positioning.matched.RG$match_accuracy_result, : Cannot compute exact
## p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.positioning.matched.RG$BORG_RG and data.positioning.matched.RG$match_accuracy_result
## S = 3447428, p-value = 0.02285
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.1340871
ggplot(data.positioning.matched.RG, aes(x = BORG_RG, y = match_accuracy_result)) +
  geom_point(color = "steelblue", size = 2, alpha = 0.7) +
  geom_smooth(method = "loess", color = "darkred", se = TRUE) +
  labs(
    title = "Correlation between Physical Exertion and Accuracy (Rotating Globe)",
    x = "Physical Exertion (BORG_RG)",
    y = "Match Accuracy Result"
  ) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

data.positioning.matched.NRG <- data.positioning.matched %>% 
  filter(positionCondition == "nonRotatingGlobe")

cor.test(data.positioning.matched.NRG$BORG_NRG, 
         data.positioning.matched.NRG$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.positioning.matched.NRG$BORG_NRG,
## data.positioning.matched.NRG$match_accuracy_result, : Cannot compute exact
## p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.positioning.matched.NRG$BORG_NRG and data.positioning.matched.NRG$match_accuracy_result
## S = 3491838, p-value = 0.03706
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.1229323
ggplot(data.positioning.matched.NRG, aes(x = BORG_NRG, y = match_accuracy_result)) +
  geom_point(color = "steelblue", size = 2, alpha = 0.7) +
  geom_smooth(method = "loess", color = "darkred", se = TRUE) +
  labs(
    title = "Correlation between Physical Exertion and Accuracy (Non-rotating Globe)",
    x = "Physical Exertion (BORG_NRG)",
    y = "Match Accuracy Result"
  ) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at -0.02
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 3.02
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1.74e-16
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## -0.02
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 3.02
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 1.74e-16
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 4

data.positioning.taskCompletion_avg.RG <- data.positioning %>%
  group_by(UserID, positionCondition, PAAS_RG, BORG_RG, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  ) %>%
  filter(positionCondition == "rotatingGlobe")

cor.test(data.positioning.taskCompletion_avg.RG$BORG_RG, 
         data.positioning.taskCompletion_avg.RG$completion_time, method = "spearman")
## Warning in cor.test.default(data.positioning.taskCompletion_avg.RG$BORG_RG, :
## Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.positioning.taskCompletion_avg.RG$BORG_RG and data.positioning.taskCompletion_avg.RG$completion_time
## S = 3103888, p-value = 0.0001632
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.2203763
data.positioning.taskCompletion_avg.NRG <- data.positioning %>%
  group_by(UserID, positionCondition, PAAS_NRG, BORG_NRG, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  ) %>%
  filter(positionCondition == "nonRotatingGlobe")

cor.test(data.positioning.taskCompletion_avg.NRG$BORG_NRG, 
         data.positioning.taskCompletion_avg.NRG$completion_time, method = "spearman")
## Warning in cor.test.default(data.positioning.taskCompletion_avg.NRG$BORG_NRG, :
## Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.positioning.taskCompletion_avg.NRG$BORG_NRG and data.positioning.taskCompletion_avg.NRG$completion_time
## S = 4081328, p-value = 0.671
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##         rho 
## -0.02513373
# PAAS vs Accuracy
data.positioning.matched.RG$condition <- "RG"
data.positioning.matched.NRG$condition <- "NRG"

data.positioning.matched.PAAS_combined <- bind_rows(
  data.positioning.matched.RG %>% rename(PAAS = PAAS_RG),
  data.positioning.matched.NRG %>% rename(PAAS = PAAS_NRG)
)

ggplot(data.positioning.matched.PAAS_combined, aes(x = PAAS, y = match_accuracy_result, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Mental Exertion vs Match Accuracy in Positioning",
    x = "PAAS Scale",
    y = "Match Accuracy",
    color = "Condition"
  ) +
  scale_color_manual(values = c("RG" = "blue", "NRG" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

# PAAS vs Completion Time

data.positioning.taskCompletion_avg.RG$condition <- "RG"
data.positioning.taskCompletion_avg.NRG$condition <- "NRG"

data.positioning.taskCompletion_avg.PAAS_combined <- bind_rows(
  data.positioning.taskCompletion_avg.RG %>% 
    rename(PAAS = PAAS_RG),
  data.positioning.taskCompletion_avg.NRG %>% 
    rename(PAAS = PAAS_NRG)
)

ggplot(data.positioning.taskCompletion_avg.PAAS_combined, aes(x = PAAS, y = completion_time, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Mental Exertion vs Completion Time in Positioning",
    x = "PASS Scale",
    y = "Completion Time",
    color = "Condition"
  ) +
  scale_color_manual(values = c("RG" = "blue", "NRG" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

# BORG vs Accuracy
data.positioning.matched.RG$condition <- "RG"
data.positioning.matched.NRG$condition <- "NRG"

data.positioning.matched.BORG_combined <- bind_rows(
  data.positioning.matched.RG %>% rename(BORG = BORG_RG),
  data.positioning.matched.NRG %>% rename(BORG = BORG_NRG)
)

ggplot(data.positioning.matched.BORG_combined, aes(x = BORG, y = match_accuracy_result, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Physical Exertion vs Match Accuracy in Positioning",
    x = "BORG Scale",
    y = "Match Accuracy",
    color = "Condition"
  ) +
  scale_color_manual(values = c("RG" = "blue", "NRG" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

# BORG vs Completion Time

data.positioning.taskCompletion_avg.RG$condition <- "RG"
data.positioning.taskCompletion_avg.NRG$condition <- "NRG"

data.positioning.taskCompletion_avg.BORG_combined <- bind_rows(
  data.positioning.taskCompletion_avg.RG %>% 
    rename(BORG = BORG_RG),
  data.positioning.taskCompletion_avg.NRG %>% 
    rename(BORG = BORG_NRG)
)

ggplot(data.positioning.taskCompletion_avg.BORG_combined, aes(x = BORG, y = completion_time, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Physical Exertion vs Completion Time  in Positioning",
    x = "BORG Scale",
    y = "Completion Time",
    color = "Condition"
  ) +
  scale_color_manual(values = c("RG" = "blue", "NRG" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

#### Preference
data.positioning %>%
  select(UserID, behaviour_preference) %>%
  distinct() %>%  
  count(behaviour_preference) %>%
  mutate(
    percent = n / sum(n),
    ncount = paste0(n, "\n", percent_format()(percent))
  ) %>%
  ggplot(aes(x = "", y = n, fill = behaviour_preference)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  geom_text(aes(label = ncount), position = position_stack(vjust = 0.5), size = 4) +
  labs(
    title = "Distribution of Positioning Behaviour Preferences",
    fill = "Preference"
  ) +
  theme_void()

#### Comments

data.positioning.preference.summary <- data.positioning %>%
  mutate(
    behaviour_preference = case_when(
      behaviour_preference == "staticOrientation" ~ "Static Orientation",
      behaviour_preference == "adaptiveOrientation" ~ "Adaptive Orientation",
      behaviour_preference == "noPreference" ~ "No Preference",
      TRUE ~ behaviour_preference
    )
  ) %>%
  group_by(UserID) %>%
  summarise(
    behaviour_preference = first(behaviour_preference),
    behaviour_feedback = first(behaviour_feedback),
    .groups = "drop"
  )

kable(data.positioning.preference.summary, caption = "User Feedback Summary - Positioning")
User Feedback Summary - Positioning
UserID behaviour_preference behaviour_feedback
1 Static Orientation I prefer the static orientation as it makes me feel more enjoyable and easy to move it. However, in relation to moving the globe, I think, gaze is effective enough but the pinch gesture must be changed into other gestures such as thumb movement.
2 Adaptive Orientation Static orientation give me a little bit of nausea. And regarding the control, the x and y axis gesture is easy to control, but for both negative and positive z-axis is a bit hard to do since its depends on my hand’s position and hand’s length.
3 Static Orientation Static is more intuitove because it only display 1 type of direction to control than adaptive. In order to rotate the globe, i suggest to introduce one more gesture where we can pinch and rotate finger at the same time.
4 Static Orientation I like it when it static it is more dynamic and realistic like a globe should be, to move the globe I think it would be better if we can pinch and throw the globe to the designated positions. or maybe we can move the globe by the palm of our hands.
5 Adaptive Orientation It’s easier to see the same side and of the earth. It will be better if I can grab it like a real globe
6 Static Orientation I prefer the static one because it more realistic, more natural.its more convenient to observe, and it feels like we use real globe. I feel the gaze and pinch method is better that’s directly touch, it is also less prone to errors.
7 Adaptive Orientation I prefer the adaptive orientation one because it remains focused and detailed.
8 Static Orientation The static one feels more real like physical globe. It would be convinient if there is a frame like a physical globe where we can move the globe around with that.
9 Static Orientation I prefer the static one because its more intuitive
10 Adaptive Orientation I prefer adaptive one because its easier to observe the surface.
11 Static Orientation I prefer static because its easier to focus on the globe and less confusing
12 No Preference 1. It depends on the situation, if the situation doesn’t require me to actually show the globe to other people, I wouldn’t mind if it doesn’t move. But, if it requires me to show other people (live presentation), I would want it to adaptively look towards me every time. Because if not I need to always adjust the orientation.
  1. The DPI needs to be adaptive, my preference is to pinch the globe and move it towards the destination. But, it always falls shorter than it should have been.
  2. I had difficulty in selecting the main globe when it is obstructed by the target globe. This is due to the need to repinch when my hand is out of space. |
### Summary

Study: Rotating

Rotating Data Preparation

data.rotating <- data %>%
  inner_join(demographic, by = "UserID") %>%
  inner_join(rotation_OH, by = "UserID") %>%
  rename(
    PAAS_OH = Mentally_demanding,
    BORG_OH = Physically_demanding
  ) %>%
  mutate(
    PAAS_OH = as.numeric(str_extract(PAAS_OH, "\\d+(\\.\\d+)?")),
    BORG_OH = as.numeric(str_extract(BORG_OH, "\\d+(\\.\\d+)?"))
  ) %>%
  inner_join(rotation_TH, by = "UserID") %>%
  rename(
    PAAS_TH = Mentally_demanding,
    BORG_TH = Physically_demanding
  ) %>%
  mutate(
    PAAS_TH = as.numeric(str_extract(PAAS_TH, "\\d+(\\.\\d+)?")),
    BORG_TH = as.numeric(str_extract(BORG_TH, "\\d+(\\.\\d+)?"))
  ) %>%  
  inner_join(rotation_preference, by = "UserID") %>%
  rename(
    behaviour_preference = Rotation_preference,
    behaviour_feedback = Rotation_feedback
  ) %>%
  mutate(
      behaviour_preference = case_when(
    str_detect(behaviour_preference, "One-handed") ~ "oneHandedPreference",
    str_detect(behaviour_preference, "Two-handed") ~ "twoHandedPreference",
    str_detect(behaviour_preference, "no preference") ~ "noPreference",
    TRUE ~ "unknown"
  )) %>%
  filter(Type == "rotationTask") %>%
  select(UserID, TaskID, ActionID, oneHandedRotationGesture, complexity, Date, ActionStatus, main_rotation_x,
  main_rotation_y, main_rotation_z, main_rotation_w, target_rotation_x, target_rotation_y, target_rotation_z,
  target_rotation_w,match_accuracy_result, status, PAAS_OH, BORG_OH, PAAS_TH, BORG_TH, behaviour_preference, behaviour_feedback) %>%
  mutate(rotationCondition = if_else(oneHandedRotationGesture, "oneHanded", "twoHanded")) %>%
  select(-oneHandedRotationGesture) %>%
  mutate(complexity = as.factor(complexity), 
         rotationCondition = as.factor(rotationCondition),
         status = as.factor(status),
         behaviour_preference = as.factor(behaviour_preference))

Rotation Task Study

### Accuracy
#### Normality
data.rotating.matched <- data.rotating %>%
  filter(status == "Matched")

shapiro.test(data.rotating.matched$match_accuracy_result)
## 
##  Shapiro-Wilk normality test
## 
## data:  data.rotating.matched$match_accuracy_result
## W = 0.94156, p-value = 5.023e-07
hist(data.rotating.matched$match_accuracy_result, breaks = 100,
     main = "Histogram (Zoomed)", xlab = "Accuracy",
     col = "lightblue", xlim = c(0, 0.5))

plot(density(data.rotating.matched$match_accuracy_result), 
     main = "Density Plot (Zoomed)", xlab = "Accuracy",
     col = "blue", lwd = 2, xlim = c(0, 0.5))

# Although the w value is close to 1, the p value is below 0.05 so we reject null hypothesis that the data is normally distributed
# So, we cannot use one way ANOVA, instead, we use Wilcoxon signed-rank test

#### Statistical tests 
data.rotating.matched.accuracy_avg.long <- data.rotating.matched %>%
  group_by(UserID, rotationCondition) %>%
  summarise(mean_accuracy = mean(match_accuracy_result, na.rm = TRUE), .groups = 'drop') 

data.rotating.matched.art <- art(mean_accuracy ~ rotationCondition + (1|UserID), data = data.rotating.matched.accuracy_avg.long)

anova(data.rotating.matched.art)
## boundary (singular) fit: see help('isSingular')
## Analysis of Variance of Aligned Rank Transformed Data
## 
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df) 
## Model: Mixed Effects (lmer)
## Response: art(mean_accuracy)
## 
##                          F Df Df.res   Pr(>F)  
## 1 rotationCondition 6.2209  1     11 0.029814 *
## ---
## Signif. codes:   0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#   Because p < .05, the result is considered statistically significant.
# Therefore, we reject the null hypothesis and conclude that rotation affects accuracy.

# An ART ANOVA revealed a significant main effect of rotation condition on mean accuracy, F(1, 11) = 6.22, p = .030, indicating that the presence of globe rotation influenced the participants’ accuracy during the task.


ggplot(data.rotating.matched.accuracy_avg.long, aes(x = rotationCondition, y = mean_accuracy, group = UserID)) +
  geom_line(aes(color = as.factor(UserID))) +
  geom_point(size = 3) +
  labs(title = "Paired Accuracy: Moving vs Non-Moving Globe",
       x = "Condition",
       y = "Match Accuracy") +
  theme_minimal()

ggplot(data.rotating.matched.accuracy_avg.long, aes(x = rotationCondition, y = mean_accuracy)) +
  geom_boxplot(outlier.shape = NA, fill = "lightblue") +
  geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
  labs(title = "Accuracy by Globe Movement Condition",
       x = "Condition",
       y = "Match Accuracy") +
  theme_minimal()

### Completion Time
data.rotating.taskCompletion_avg <- data.rotating %>%
  group_by(UserID, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  )

shapiro.test(data.rotating.taskCompletion_avg$completion_time)
## 
##  Shapiro-Wilk normality test
## 
## data:  data.rotating.taskCompletion_avg$completion_time
## W = 0.49195, p-value < 2.2e-16
data.rotating.taskCompletion_avg.long <- data.rotating %>%
  group_by(UserID, rotationCondition, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  ) %>%
  group_by(UserID, rotationCondition) %>%
  summarise(
    avg_completion_time = mean(completion_time),
    .groups = "drop"
  )

data.rotating.taskCompletion_avg.art <- art(avg_completion_time ~ rotationCondition + (1|UserID), data = data.rotating.taskCompletion_avg.long)

anova(data.rotating.taskCompletion_avg.art)
## Analysis of Variance of Aligned Rank Transformed Data
## 
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df) 
## Model: Mixed Effects (lmer)
## Response: art(avg_completion_time)
## 
##                          F Df Df.res   Pr(>F)  
## 1 rotationCondition 6.4517  1     11 0.027479 *
## ---
## Signif. codes:   0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# F(1, 11) = 6.45, p = 0.027
# Since the p-value is less than 0.05, the result is statistically significant.
# This means that rotationCondition has a significant effect on avg_completion_time.
# 
# An aligned rank transform ANOVA revealed a significant effect of rotation condition on task completion time, F(1, 11) = 6.45, p = .027.

ggplot(data.rotating.taskCompletion_avg.long, aes(x = rotationCondition, y = avg_completion_time, group = UserID)) +
  geom_line(aes(color = as.factor(UserID)), linewidth = 1, alpha = 0.6) +
  geom_point(size = 3) +
  labs(
    title = "Task Completion Time by Condition",
    x = "Condition",
    y = "Completion Time (minutes)",
    color = "UserID"
  ) +
  theme_minimal()

ggplot(data.rotating.taskCompletion_avg.long, aes(x = rotationCondition, y = avg_completion_time)) +
  geom_boxplot(outlier.shape = NA, fill = "lightblue") +
  geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
  labs(title = "Accuracy by Globe Movement Condition",
       x = "Condition",
       y = "Match Accuracy") +
  theme_minimal()

### Subjective Measures
#### Physical and Mental Exertion
# Spearman’s rank correlation is a non-parametric test.
# It does not assume normal distribution of the variables.
# It works on ranks of the data, not the raw values — so it’s robust against skewed or non-normal distributions.

data.rotating.matched.OH <- data.rotating.matched %>% 
  filter(rotationCondition == "oneHanded")

cor.test(data.rotating.matched.OH$BORG_OH, 
         data.rotating.matched.OH$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.rotating.matched.OH$BORG_OH,
## data.rotating.matched.OH$match_accuracy_result, : Cannot compute exact p-value
## with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.rotating.matched.OH$BORG_OH and data.rotating.matched.OH$match_accuracy_result
## S = 152593, p-value = 0.7353
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## -0.0349492
ggplot(data.rotating.matched.OH, aes(x = BORG_OH, y = match_accuracy_result)) +
  geom_point(color = "steelblue", size = 2, alpha = 0.7) +
  geom_smooth(method = "loess", color = "darkred", se = TRUE) +
  labs(
    title = "Correlation between Physical Exertion and Accuracy (One Handed)",
    x = "Physical Exertion (BORG_OH)",
    y = "Match Accuracy Result"
  ) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 1
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 1
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 5.4581e-17
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at 1
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius 1
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 5.4581e-17

data.rotating.matched.TH <- data.rotating.matched %>% 
  filter(rotationCondition == "twoHanded")

cor.test(data.rotating.matched.TH$BORG_TH, 
         data.rotating.matched.TH$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.rotating.matched.TH$BORG_TH,
## data.rotating.matched.TH$match_accuracy_result, : Cannot compute exact p-value
## with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.rotating.matched.TH$BORG_TH and data.rotating.matched.TH$match_accuracy_result
## S = 133640, p-value = 0.3644
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## 0.09359448
ggplot(data.rotating.matched.TH, aes(x = BORG_TH, y = match_accuracy_result)) +
  geom_point(color = "steelblue", size = 2, alpha = 0.7) +
  geom_smooth(method = "loess", color = "darkred", se = TRUE) +
  labs(
    title = "Correlation between Physical Exertion and Accuracy (Two Handed)",
    x = "Physical Exertion (BORG_TH)",
    y = "Match Accuracy Result"
  ) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

data.rotating.taskCompletion_avg.OH <- data.rotating %>%
  group_by(UserID, rotationCondition, PAAS_OH, BORG_OH, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  ) %>%
  filter(rotationCondition == "oneHanded")

cor.test(data.rotating.taskCompletion_avg.OH$BORG_OH, 
         data.rotating.taskCompletion_avg.OH$completion_time, method = "spearman")
## Warning in cor.test.default(data.rotating.taskCompletion_avg.OH$BORG_OH, :
## Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.rotating.taskCompletion_avg.OH$BORG_OH and data.rotating.taskCompletion_avg.OH$completion_time
## S = 139512, p-value = 0.6029
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## 0.05376892
data.rotating.taskCompletion_avg.TH <- data.rotating %>%
  group_by(UserID, rotationCondition, PAAS_TH, BORG_TH, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  ) %>%
  filter(rotationCondition == "twoHanded")

cor.test(data.rotating.taskCompletion_avg.TH$BORG_TH, 
         data.rotating.taskCompletion_avg.TH$completion_time, method = "spearman")
## Warning in cor.test.default(data.rotating.taskCompletion_avg.TH$BORG_TH, :
## Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.rotating.taskCompletion_avg.TH$BORG_TH and data.rotating.taskCompletion_avg.TH$completion_time
## S = 131579, p-value = 0.2968
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.1075767
# PAAS vs Accuracy
data.rotating.matched.OH$condition <- "OH"
data.rotating.matched.TH$condition <- "TH"

data.rotating.matched.PAAS_combined <- bind_rows(
  data.rotating.matched.OH %>% rename(PAAS = PAAS_OH),
  data.rotating.matched.TH %>% rename(PAAS = PAAS_TH)
)

ggplot(data.rotating.matched.PAAS_combined, aes(x = PAAS, y = match_accuracy_result, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Mental Exertion vs Match Accuracy in Rotating",
    x = "PAAS Scale",
    y = "Match Accuracy",
    color = "Condition"
  ) +
  scale_color_manual(values = c("OH" = "blue", "TH" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

# PAAS vs Completion Time

data.rotating.taskCompletion_avg.OH$condition <- "OH"
data.rotating.taskCompletion_avg.TH$condition <- "TH"

data.rotating.taskCompletion_avg.PAAS_combined <- bind_rows(
  data.rotating.taskCompletion_avg.OH %>% 
    rename(PAAS = PAAS_OH),
  data.rotating.taskCompletion_avg.TH %>% 
    rename(PAAS = PAAS_TH)
)

ggplot(data.rotating.taskCompletion_avg.PAAS_combined, aes(x = PAAS, y = completion_time, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Mental Exertion vs Completion Time in Rotating",
    x = "PASS Scale",
    y = "Completion Time",
    color = "Condition"
  ) +
  scale_color_manual(values = c("RG" = "blue", "NRG" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
## Warning: No shared levels found between `names(values)` of the manual scale and the
## data's colour values.
## Warning: No shared levels found between `names(values)` of the manual scale and the
## data's colour values.
## No shared levels found between `names(values)` of the manual scale and the
## data's colour values.

# BORG vs Accuracy

data.rotating.matched.OH$condition <- "OH"
data.rotating.matched.TH$condition <- "TH"

data.rotating.matched.BORG_combined <- bind_rows(
  data.rotating.matched.OH %>% rename(BORG = BORG_OH),
  data.rotating.matched.TH %>% rename(BORG = BORG_TH)
)

ggplot(data.rotating.matched.BORG_combined, aes(x = BORG, y = match_accuracy_result, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Physical Exertion vs Match Accuracy in Rotating",
    x = "BORG Scale",
    y = "Match Accuracy",
    color = "Condition"
  ) +
  scale_color_manual(values = c("OH" = "blue", "TH" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

# BORG vs Completion Time

data.rotating.taskCompletion_avg.OH$condition <- "OH"
data.rotating.taskCompletion_avg.TH$condition <- "TH"

data.rotating.taskCompletion_avg.BORG_combined <- bind_rows(
  data.rotating.taskCompletion_avg.OH %>% 
    rename(BORG = BORG_OH),
  data.rotating.taskCompletion_avg.TH %>% 
    rename(BORG = BORG_TH)
)

ggplot(data.rotating.taskCompletion_avg.BORG_combined, aes(x = BORG, y = completion_time, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Physical Exertion vs Completion Time in Rotating",
    x = "BORG Scale",
    y = "Completion Time (min)",
    color = "Condition"
  ) +
  scale_color_manual(values = c("OH" = "blue", "TH" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

#### Preference
data.rotating %>%
  select(UserID, behaviour_preference) %>%
  distinct() %>%  
  count(behaviour_preference) %>%
  mutate(
    percent = n / sum(n),
    ncount = paste0(n, "\n", percent_format()(percent))
  ) %>%
  ggplot(aes(x = "", y = n, fill = behaviour_preference)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  geom_text(aes(label = ncount), position = position_stack(vjust = 0.5), size = 4) +
  labs(
    title = "Distribution of Rotation Behaviour Preferences",
    fill = "Preference"
  ) +
  theme_void()

#### Comments
data.rotating.preference.summary <- data.rotating %>%
  mutate(
    behaviour_preference = case_when(
      behaviour_preference == "oneHandedPreference" ~ "One Handed Gesture",
      behaviour_preference == "twoHandedPreference" ~ "Two Handed Gesture",
      behaviour_preference == "noPreference" ~ "No Preference",
      TRUE ~ behaviour_preference
    )
  ) %>%
  group_by(UserID) %>%
  summarise(
    behaviour_preference = first(behaviour_preference),
    behaviour_feedback = first(behaviour_feedback),
    .groups = "drop"
  )

kable(data.rotating.preference.summary, caption = "User Feedback Summary - Rotating")
User Feedback Summary - Rotating
UserID behaviour_preference behaviour_feedback
1 One Handed Gesture I feel more convenient to use one-handed rotation gesture because it is less confusing compared to two-handed rotation gesture, where I had a bit more difficulties in balancing my hands.
2 Two Handed Gesture I have more control with the two-handed rotation gesture, it feels more natural. But still feel limited In terms of flexibility upon rotation. I think more gesture such as moving the globe position when both hands are moving simultaneously following the centre of the hands.
3 One Handed Gesture More fingers means more calorie burns. But it has limitation with the control, not sure how to solve or give gesture recommendation.
4 One Handed Gesture I like one handed better because I have more control to rotate the orientations as I like, as for the gestures I ’ll suggest maybe we can use hands like waving gestures to rotate the globe
5 No Preference Both options have their advantages. One hand is simple but little bit harder for complex task like rotation. I think it would be better if I can rotate our pump like rotating door knob
6 One Handed Gesture I prefer one-handed gesture one because its easier to imagine the direction. However, the two-handed gesture will be useful in medical field. Especially in surgery.
7 One Handed Gesture I prefer one-handed gesture because it is handy and more flexible.
8 Two Handed Gesture I prefer two handed because it gives more flexibility. However I feel that two handed takes time to adapt. I think it would be better if we can touch and manipulate directly like aphysical globe. If the globe is far, we can use gaze and pinch to make it nearer, then we can use direct gesture manipulation.
9 One Handed Gesture I prefer one handed because it is simpler.
10 One Handed Gesture I prefer one handed because it is easier to move the globe from any directions while the two handed it is more difficult because it takes two-hands coordination. Gaze and pinch is convinient enough.
11 One Handed Gesture I prefer one handed because thats how I usually operate globe in real life. Unless the two handed uses palms like holding real globes, I’d prefer it.
12 No Preference 1. It would be better if we have the option of using two hands, instead of directly using 2 hands. It gives the option of z axis adjustment in the middle of x,y axis rotation.
  1. It would be better if we could rotate it with our palm like in iron man 2.
  2. It would be confusing when you try to combine both rotation and position with the same gestures. |
### Summary

Study: Scale

Scale Data Preparation

data.scale <- data %>%
  inner_join(demographic, by = "UserID") %>%
  inner_join(scale_MG, by = "UserID") %>%
    rename(
    PAAS_MG = Mentally_demanding,
    BORG_MG = Physically_demanding
  ) %>%
  mutate(
    PAAS_MG = as.numeric(str_extract(PAAS_MG, "\\d+(\\.\\d+)?")),
    BORG_MG = as.numeric(str_extract(BORG_MG, "\\d+(\\.\\d+)?"))
  ) %>%
  inner_join(scale_NMG, by = "UserID") %>%
  rename(
    PAAS_NMG = Mentally_demanding,
    BORG_NMG = Physically_demanding
  ) %>%
  mutate(
    PAAS_NMG = as.numeric(str_extract(PAAS_NMG, "\\d+(\\.\\d+)?")),
    BORG_NMG = as.numeric(str_extract(BORG_NMG, "\\d+(\\.\\d+)?"))
  ) %>%
  inner_join(scale_preference, by = "UserID") %>%
  rename(
    behaviour_preference = Scale_preference,
    behaviour_feedback = Scale_feedback
  ) %>%
  mutate(
    behaviour_preference = case_when(
    str_detect(behaviour_preference, "Maintain distance") ~ "maintainDistance",
    str_detect(behaviour_preference, "Maintain globe") ~ "maintainGlobe",
    str_detect(behaviour_preference, "no preference") ~ "noPreference",
    TRUE ~ "unknown"
  )) %>%
  filter(Type == "scaleTask") %>%
  select(UserID, TaskID, ActionID, moveGlobeWhileScaling, zoomDirection, Date, ActionStatus, main_scale_x,
  main_scale_y, main_scale_z, target_scale_x, target_scale_y, target_scale_z, match_accuracy_result, status,
  PAAS_MG, BORG_MG, PAAS_NMG, BORG_NMG, behaviour_preference, behaviour_feedback) %>%
  mutate(scaleCondition = if_else(moveGlobeWhileScaling, "movingGlobe", "nonMovingGlobe")) %>%
  select(-moveGlobeWhileScaling) %>%
  mutate(zoomDirection = as.factor(zoomDirection), 
         scaleCondition = as.factor(scaleCondition),
         status = as.factor(status),
         behaviour_preference = as.factor(behaviour_preference))

Scale Task Study

### Accuracy
#### Normality
data.scale.matched <- data.scale %>%
  filter(status == "Matched")

shapiro.test(data.scale.matched$match_accuracy_result)
## 
##  Shapiro-Wilk normality test
## 
## data:  data.scale.matched$match_accuracy_result
## W = 0.94732, p-value = 1.64e-06
hist(data.scale.matched$match_accuracy_result, breaks = 100,
     main = "Histogram (Zoomed)", xlab = "Accuracy",
     col = "lightblue", xlim = c(0, 0.5))

plot(density(data.scale.matched$match_accuracy_result), 
     main = "Density Plot (Zoomed)", xlab = "Accuracy",
     col = "blue", lwd = 2, xlim = c(0, 0.5))

# Although the w value is close to 1, the p value is below 0.05 so we reject null hypothesis that the data is normally distributed
# So, we cannot use one way ANOVA, instead, we use Wilcoxon signed-rank test

#### Statistical tests 
data.scale.matched.accuracy_avg.long <- data.scale.matched %>%
  group_by(UserID, scaleCondition) %>%
  summarise(mean_accuracy = mean(match_accuracy_result, na.rm = TRUE), .groups = 'drop')
  # %>%
  # pivot_wider(names_from = scaleCondition, values_from = mean_accuracy)

data.scale.matched.art <- art(mean_accuracy ~ scaleCondition + (1|UserID), data = data.scale.matched.accuracy_avg.long)

anova(data.scale.matched.art)
## Analysis of Variance of Aligned Rank Transformed Data
## 
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df) 
## Model: Mixed Effects (lmer)
## Response: art(mean_accuracy)
## 
##                        F Df Df.res Pr(>F)  
## 1 scaleCondition 0.43825  1     11 0.5216  
## ---
## Signif. codes:   0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Because p > .05, we fail to reject the null hypothesis.
# There is no evidence that changing the scale condition affects how accurately participants performed.

# An ART ANOVA showed no significant effect of scale condition on mean accuracy, F(1, 11) = 0.44, p = .522, indicating that changing the scale of the globe did not impact participants’ accuracy.

ggplot(data.scale.matched.accuracy_avg.long, aes(x = scaleCondition, y = mean_accuracy, group = UserID)) +
  geom_line(aes(color = as.factor(UserID))) +
  geom_point(size = 3) +
  labs(title = "Paired Accuracy: Moving vs Non-Moving Globe",
       x = "Condition",
       y = "Match Accuracy") +
  theme_minimal()

ggplot(data.scale.matched.accuracy_avg.long, aes(x = scaleCondition, y = mean_accuracy)) +
  geom_boxplot(outlier.shape = NA, fill = "lightblue") +
  geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
  labs(title = "Accuracy by Globe Movement Condition",
       x = "Condition",
       y = "Match Accuracy") +
  theme_minimal()

### Completion Time
data.scale.taskCompletion_avg <- data.scale %>%
  group_by(UserID, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  )

shapiro.test(data.scale.taskCompletion_avg$completion_time)
## 
##  Shapiro-Wilk normality test
## 
## data:  data.scale.taskCompletion_avg$completion_time
## W = 0.69808, p-value < 2.2e-16
data.scale.taskCompletion_avg.long <- data.scale %>%
  group_by(UserID, scaleCondition, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  ) %>%
  group_by(UserID, scaleCondition) %>%
  summarise(
    avg_completion_time = mean(completion_time),
    .groups = "drop"
  ) 
  # %>%
  # pivot_wider(names_from = scaleCondition, values_from = avg_completion_time)

data.scale.taskCompletion.art <- art(avg_completion_time ~ scaleCondition + (1|UserID), data = data.scale.taskCompletion_avg.long)

anova(data.scale.matched.art)
## Analysis of Variance of Aligned Rank Transformed Data
## 
## Table Type: Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df) 
## Model: Mixed Effects (lmer)
## Response: art(mean_accuracy)
## 
##                        F Df Df.res Pr(>F)  
## 1 scaleCondition 0.43825  1     11 0.5216  
## ---
## Signif. codes:   0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# An aligned rank transform (ART) ANOVA revealed no significant effect of scale condition on mean accuracy, F(1, 11) = 0.44, p = .522.
# There was no significant effect of scale condition on mean accuracy, F(1, 11) = 0.44, p = .522.

# wilcox.test(
#   data.scale.taskCompletion_avg.wide$movingGlobe,
#   data.scale.taskCompletion_avg.wide$nonMovingGlobe,
#   paired = TRUE,
#   alternative = "two.sided"
# )

# data.scale.taskCompletion_avg.long <- data.scale.taskCompletion_avg.wide %>%
#   pivot_longer(cols = c(movingGlobe, nonMovingGlobe),
#                names_to = "Condition",
#                values_to = "completion_time")

ggplot(data.scale.taskCompletion_avg.long, aes(x = scaleCondition, y = avg_completion_time, group = UserID)) +
  geom_line(aes(color = as.factor(UserID)), linewidth = 1, alpha = 0.6) +
  geom_point(size = 3) +
  labs(
    title = "Task Completion Time by Condition",
    x = "Condition",
    y = "Completion Time (minutes)",
    color = "UserID"
  ) +
  theme_minimal()

ggplot(data.scale.taskCompletion_avg.long, aes(x = scaleCondition, y = avg_completion_time)) +
  geom_boxplot(outlier.shape = NA, fill = "lightblue") +
  geom_jitter(width = 0.1, size = 2, alpha = 0.7) +
  labs(title = "Accuracy by Globe Movement Condition",
       x = "Condition",
       y = "Match Accuracy") +
  theme_minimal()

### Subjective Measures
#### Physical Exertion
# Spearman’s rank correlation is a non-parametric test.
# It does not assume normal distribution of the variables.
# It works on ranks of the data, not the raw values — so it’s robust against skewed or non-normal distributions.

data.scale.matched.MG <- data.scale.matched %>% 
  filter(scaleCondition == "movingGlobe")

cor.test(data.scale.matched.MG$BORG_MG, 
         data.scale.matched.MG$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.scale.matched.MG$BORG_MG,
## data.scale.matched.MG$match_accuracy_result, : Cannot compute exact p-value
## with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.scale.matched.MG$BORG_MG and data.scale.matched.MG$match_accuracy_result
## S = 130858, p-value = 0.2753
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.1124638
ggplot(data.scale.matched.MG, aes(x = BORG_MG, y = match_accuracy_result)) +
  geom_point(color = "steelblue", size = 2, alpha = 0.7) +
  geom_smooth(method = "loess", color = "darkred", se = TRUE) +
  labs(
    title = "Correlation between Physical Exertion and Accuracy (Moving Globe)",
    x = "Physical Exertion (BORG_MG)",
    y = "Match Accuracy Result"
  ) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at -0.015
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 1.015
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 3.0914e-16
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 0.25
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## -0.015
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 1.015
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 3.0914e-16
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 0.25

data.scale.matched.NMG <- data.scale.matched %>% 
  filter(scaleCondition == "nonMovingGlobe")

cor.test(data.scale.matched.NMG$BORG_NMG, 
         data.scale.matched.NMG$match_accuracy_result, method = "spearman")
## Warning in cor.test.default(data.scale.matched.NMG$BORG_NMG,
## data.scale.matched.NMG$match_accuracy_result, : Cannot compute exact p-value
## with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.scale.matched.NMG$BORG_NMG and data.scale.matched.NMG$match_accuracy_result
## S = 176003, p-value = 0.05859
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## -0.1937286
ggplot(data.scale.matched.NMG, aes(x = BORG_NMG, y = match_accuracy_result)) +
  geom_point(color = "steelblue", size = 2, alpha = 0.7) +
  geom_smooth(method = "loess", color = "darkred", se = TRUE) +
  labs(
    title = "Correlation between Physical Exertion and Accuracy (Non-moving Globe)",
    x = "Physical Exertion (BORG_NMG)",
    y = "Match Accuracy Result"
  ) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at -0.015
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 1.015
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1.7288e-16
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 0.25
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## -0.015
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 1.015
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 1.7288e-16
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 0.25

data.scale.taskCompletion_avg.MG <- data.scale %>%
  group_by(UserID, scaleCondition, PAAS_MG, BORG_MG, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  ) %>%
  filter(scaleCondition == "movingGlobe")

cor.test(data.scale.taskCompletion_avg.MG$BORG_MG, 
         data.scale.taskCompletion_avg.MG$completion_time, method = "spearman")
## Warning in cor.test.default(data.scale.taskCompletion_avg.MG$BORG_MG,
## data.scale.taskCompletion_avg.MG$completion_time, : Cannot compute exact
## p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.scale.taskCompletion_avg.MG$BORG_MG and data.scale.taskCompletion_avg.MG$completion_time
## S = 103893, p-value = 0.003484
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.2953543
data.scale.taskCompletion_avg.NMG <- data.scale %>%
  group_by(UserID, scaleCondition, PAAS_NMG, BORG_NMG, TaskID) %>%
  summarise(
    completion_time = as.numeric(difftime(max(Date), min(Date), units = "mins")),
    .groups = "drop"
  ) %>%
  filter(scaleCondition == "nonMovingGlobe")

cor.test(data.scale.taskCompletion_avg.NMG$BORG_NMG, 
         data.scale.taskCompletion_avg.NMG$completion_time, method = "spearman")
## Warning in cor.test.default(data.scale.taskCompletion_avg.NMG$BORG_NMG, :
## Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  data.scale.taskCompletion_avg.NMG$BORG_NMG and data.scale.taskCompletion_avg.NMG$completion_time
## S = 93356, p-value = 0.0002369
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.3668193
# PAAS vs Accuracy
data.scale.matched.MG$condition <- "MG"
data.scale.matched.NMG$condition <- "NMG"

data.scale.matched.PAAS_combined <- bind_rows(
  data.scale.matched.MG %>% rename(PAAS = PAAS_MG),
  data.scale.matched.NMG %>% rename(PAAS = PAAS_NMG)
)

ggplot(data.scale.matched.PAAS_combined, aes(x = PAAS, y = match_accuracy_result, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Mental Exertion vs Match Accuracy in scale",
    x = "PAAS Scale",
    y = "Match Accuracy",
    color = "Condition"
  ) +
  scale_color_manual(values = c("MG" = "blue", "NMG" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

# PAAS vs Completion Time

data.scale.taskCompletion_avg.MG$condition <- "MG"
data.scale.taskCompletion_avg.NMG$condition <- "NMG"

data.scale.taskCompletion_avg.PAAS_combined <- bind_rows(
  data.scale.taskCompletion_avg.MG %>% 
    rename(PAAS = PAAS_MG),
  data.scale.taskCompletion_avg.NMG %>% 
    rename(PAAS = PAAS_NMG)
)

ggplot(data.scale.taskCompletion_avg.PAAS_combined, aes(x = PAAS, y = completion_time, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Mental Exertion vs Completion Time in scale",
    x = "PASS Scale",
    y = "Completion Time",
    color = "Condition"
  ) +
  scale_color_manual(values = c("MG" = "blue", "NMG" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

# BORG vs Accuracy
data.scale.matched.MG$condition <- "MG"
data.scale.matched.NMG$condition <- "NMG"

data.scale.matched.BORG_combined <- bind_rows(
  data.scale.matched.MG %>% rename(BORG = BORG_MG),
  data.scale.matched.NMG %>% rename(BORG = BORG_NMG)
)

ggplot(data.scale.matched.BORG_combined, aes(x = BORG, y = match_accuracy_result, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Physical Exertion vs Match Accuracy",
    x = "BORG Scale",
    y = "Match Accuracy",
    color = "Condition"
  ) +
  scale_color_manual(values = c("RG" = "blue", "NRG" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
## Warning: No shared levels found between `names(values)` of the manual scale and the
## data's colour values.
## Warning: No shared levels found between `names(values)` of the manual scale and the
## data's colour values.
## No shared levels found between `names(values)` of the manual scale and the
## data's colour values.

# BORG vs Completion Time

data.scale.taskCompletion_avg.MG$condition <- "RG"
data.scale.taskCompletion_avg.NMG$condition <- "NRG"

data.scale.taskCompletion_avg.BORG_combined <- bind_rows(
  data.scale.taskCompletion_avg.MG %>% 
    rename(BORG = BORG_MG),
  data.scale.taskCompletion_avg.NMG %>% 
    rename(BORG = BORG_NMG)
)

ggplot(data.scale.taskCompletion_avg.BORG_combined, aes(x = BORG, y = completion_time, color = condition)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Physical Exertion vs Completion Time",
    x = "BORG Scale",
    y = "Completion Time (min)",
    color = "Condition"
  ) +
  scale_color_manual(values = c("MG" = "blue", "NMG" = "red")) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
## Warning: No shared levels found between `names(values)` of the manual scale and the
## data's colour values.
## No shared levels found between `names(values)` of the manual scale and the
## data's colour values.
## No shared levels found between `names(values)` of the manual scale and the
## data's colour values.

#### Preference
data.scale %>%
  select(UserID, behaviour_preference) %>%
  distinct() %>%  
  count(behaviour_preference) %>%
  mutate(
    percent = n / sum(n),
    ncount = paste0(n, "\n", percent_format()(percent))
  ) %>%
  ggplot(aes(x = "", y = n, fill = behaviour_preference)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  geom_text(aes(label = ncount), position = position_stack(vjust = 0.5), size = 4) +
  labs(
    title = "Distribution of Scale Behaviour Preferences",
    fill = "Preference"
  ) +
  theme_void()

#### Comments
data.scale.preference.summary <- data.scale %>%
  mutate(
    behaviour_preference = case_when(
      behaviour_preference == "maintainDistance" ~ "Maintain Globe's Distance",
      behaviour_preference == "maintainGlobe" ~ "Maintain Globe's Position",
      behaviour_preference == "noPreference" ~ "No Preference",
      TRUE ~ behaviour_preference
    )
  ) %>%
  group_by(UserID) %>%
  summarise(
    behaviour_preference = first(behaviour_preference),
    behaviour_feedback = first(behaviour_feedback),
    .groups = "drop"
  )

kable(data.scale.preference.summary, caption = "User Feedback Summary - Scale")
User Feedback Summary - Scale
UserID behaviour_preference behaviour_feedback
1 Maintain Globe’s Distance I prefer maintain globe position since it makes me easy to observe the globe closely and clearly, because I think the maintain distance one is not close enough and a bit blurry.
2 Maintain Globe’s Distance For me personally I like to use the maintain distance to globe behaviour because its easier to see when observing the surface. But depends on the situation, if we are in a bigger room such as auditorium it will be more managable. But since in this I’m doing it in a small room, its easier to use the maintain distance to globe.
3 Maintain Globe’s Distance For the scope of this globe experiment, I prefer “maintain distance…”, because I do not think it is necessary to go inside the globe which is empty. However, the zoom level for “maintain distance…” behaviour needs to be closer or have zoom level control, I.e, “Observing a very small island in the globe, like Bermuda island”
4 Maintain Globe’s Distance I like the 2nd options better so we can observe the globe more detail, without being worry about the globe disappear in front of us.
5 Maintain Globe’s Position I prefer maintain globe position because the zoom level is larger, so I can easily observe the object
6 Maintain Globe’s Distance For specifically observing maps/globes, I prefer the maiaintain distance to globes one because, ithe maximum zoom level is enough for me to observe the surface of the globe.
7 Maintain Globe’s Distance I prefer the maintain distance to globe because it is easier to observe t, the zoom level of maintain distance to globe is good.
8 No Preference Depends on the situation. I have no preference. Maintain distance is confusing whether the gesture is broken or not at the maximum zoom point. But if the purpose is for observing the globe the maintain distance is better.
9 Maintain Globe’s Distance I prefer maintain distance
10 Maintain Globe’s Distance I prefer the maintain distance because it is easier to observe the surface in a proper distance
11 No Preference It depends, for professionals like maybe government, if they want to observe details, it would better use maintain globe. But for casual users, they would not like the globe zoomed through their heads, they would like maintain distance better. So, I have no preference.
12 Maintain Globe’s Distance 1. It would be better if the limit of the zoom is very close (increase the limit) to our face or at least give the option to.
  1. The DPI and the speed of scaling in and out need to be adjusted. It is more into the callibration of the hands gesture and the actual object.
  2. It is difficult to combine the zoom gestures and the rotation with two hands. |
### Summary